home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue55 / Contain / TestRig.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2000-02-02  |  3.1 KB  |  140 lines
  1. unit TestRig;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, FlexiSort, TypInfo, Grids, ExtCtrls;
  8.  
  9. type
  10.   TTestClass = class(TRTTIObject)
  11.   private
  12.     FPStr: String;
  13.     FPInt: Integer;
  14.     FPBool: Boolean;
  15.     FPCurr: Currency;
  16.     FPDateTime: TDateTime;
  17.   published
  18.     property PStr: String read FPStr write FPStr;
  19.     property PInt: Integer read FPInt write FPInt;
  20.     property PBool: Boolean read FPBool write FPBool;
  21.     property PCurr: Currency read FPCurr write FPCurr;
  22.     property PDateTime: TDateTime read FPDateTime write FPDateTime;
  23.   end;
  24.  
  25.   TfrmTestRig = class(TForm)
  26.     Panel1: TPanel;
  27.     grdG: TStringGrid;
  28.     bSort0: TButton;
  29.     bSort1: TButton;
  30.     bSort2: TButton;
  31.     bSort3: TButton;
  32.     bSort4: TButton;
  33.     procedure FormShow(Sender: TObject);
  34.     procedure bSort0Click(Sender: TObject);
  35.     procedure bSort1Click(Sender: TObject);
  36.     procedure bSort2Click(Sender: TObject);
  37.     procedure bSort3Click(Sender: TObject);
  38.     procedure bSort4Click(Sender: TObject);
  39.   private
  40.     FSL: TFlexiSortList;
  41.     procedure LoadGrid;
  42.   public
  43.   end;
  44.  
  45. var
  46.   frmTestRig: TfrmTestRig;
  47.  
  48. implementation
  49.  
  50. {$R *.DFM}
  51.  
  52. const
  53.   ROW_COUNT = 100;
  54.  
  55. procedure TfrmTestRig.bSort0Click(Sender: TObject);
  56. begin
  57.   FSL.Sort(['PCurr']);
  58.   LoadGrid;
  59. end;
  60.  
  61. procedure TfrmTestRig.bSort1Click(Sender: TObject);
  62. begin
  63.   FSL.Sort(['A:PInt', 'D:PDateTime']);
  64.   LoadGrid;
  65. end;
  66.  
  67. procedure TfrmTestRig.bSort2Click(Sender: TObject);
  68. begin
  69.   FSL.Sort(['D:PBool', 'PStr']);
  70.   LoadGrid;
  71. end;
  72.  
  73. procedure TfrmTestRig.bSort3Click(Sender: TObject);
  74. begin
  75.   FSL.Sort(['PInt', 'D:PStr']);
  76.   LoadGrid;
  77. end;
  78.  
  79. procedure TfrmTestRig.bSort4Click(Sender: TObject);
  80. begin
  81.   FSL.Sort(['A:PInt', 'A:PBool', 'A:PCurr']);
  82.   LoadGrid;
  83. end;
  84.  
  85. procedure TfrmTestRig.FormShow(Sender: TObject);
  86. var
  87.   I: Integer;
  88.   TC: TTestClass;
  89.   function GenString: String;
  90.   var
  91.     I: Integer;
  92.   begin
  93.     Result := '     ';
  94.     for I := 1 to 5 do
  95.     begin
  96.       Result[I] := Char(Random(26) + Ord('A'));
  97.     end;
  98.   end;
  99. begin
  100.   FSL := TFlexiSortList.Create(TTestClass);
  101.   grdG.Cells[0, 0] := 'A String';
  102.   grdG.Cells[1, 0] := 'An Int';
  103.   grdG.Cells[2, 0] := 'A Bool';
  104.   grdG.Cells[3, 0] := 'A Curr';
  105.   grdG.Cells[4, 0] := 'A DateTime';
  106.   for I := 0 to (ROW_COUNT - 1) do
  107.   begin
  108.     TC := TTestClass.Create;
  109.     TC.PStr := GenString;
  110.     TC.PInt := Random(5);
  111.     TC.PBool := Odd(I);
  112.     TC.PCurr := Round(Random * 10000.0) / 100.0;
  113.     TC.PDateTime := Now + I + Random;
  114.     FSL.Add(TC);
  115.   end;
  116.   LoadGrid;
  117. end;
  118.  
  119. procedure TfrmTestRig.LoadGrid;
  120. var
  121.   I: Integer;
  122.   TC: TTestClass;
  123. begin
  124.   grdG.RowCount := ROW_COUNT + 1;
  125.   for I := 1 to ROW_COUNT do
  126.   begin
  127.     TC := TTestClass(FSL[I - 1]);
  128.     grdG.Cells[0, I] := TC.PStr;
  129.     grdG.Cells[1, I] := IntToStr(TC.PInt);
  130.     if TC.PBool then
  131.       grdG.Cells[2, I] := 'True'
  132.     else
  133.       grdG.Cells[2, I] := 'False';
  134.     grdG.Cells[3, I] := CurrToStr(TC.PCurr);
  135.     grdG.Cells[4, I] := DateTimeToStr(TC.PDateTime);
  136.   end;
  137. end;
  138.  
  139. end.
  140.